home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 143 (1990-08-15)(Ossowski, Stefan)(DE)(PD).adf / SASTools / UFO / UFO.mod < prev    next >
Text File  |  1990-05-16  |  4KB  |  95 lines
  1. (***************************************************************************
  2. *  Programme : UFO.mod                                                     *
  3. *  Usage     : UFO                                                         *
  4. *  Version   : V1.20                                                       *
  5. *  Date      : 27.-30.11.1989                                              *
  6. *  Author    : Jörg Sixt                                                   *
  7. *  Purpose   : a useful tool to damage useless screens                     *
  8. *  Language  : Modula-2,AMSoft  PD-Version from Fish 113                   *
  9. *  Bugs      : does not use input.device                                   *
  10. ***************************************************************************)
  11.  
  12. MODULE UFO ;
  13.  
  14. FROM SYSTEM     IMPORT ADR,ADDRESS,INLINE ;
  15. FROM Graphics   IMPORT SimpleSprite,GetSprite,MoveSprite,FreeSprite,ViewModes,
  16.                        ViewModeSet,RastPortPtr,ViewPortPtr,ReadPixel,SetAPen,
  17.                        Move,Draw ;
  18. FROM Intuition  IMPORT IntuitionBase,OpenIntuition,ScreenPtr ;
  19. FROM Exec       IMPORT AllocMem,FreeMem,MemReqs,MemReqSet,CopyMem ;
  20. FROM Arts       IMPORT TermProcedure,Terminate ;
  21. FROM Dos        IMPORT Delay ;
  22.  
  23. VAR  MemPtr    : ADDRESS ;
  24.      ScrPtr    : ScreenPtr ;
  25.      Raster    : RastPortPtr ;
  26.      Viewer    : ViewPortPtr ;
  27.      IBase     : POINTER TO IntuitionBase ;
  28.      SimSprite : SimpleSprite ;
  29.      NumSprite,
  30.      xs,ys,xf,yf,i,
  31.      minx,miny : INTEGER ;
  32.      CIAA [12577793] : CHAR ;
  33.  
  34. PROCEDURE SpriteData ;
  35.      BEGIN
  36.        INLINE(   00000H,00000H,       00180H,00180H,         003C0H,00180H,
  37.               007E0H,              00240H,       00FF0H,  003C0H,
  38.               01FF8H,              00420H,       03FFCH,  00420H,
  39.                  07FFEH,00810H,    0FFFFH,0FFFFH,0FFFFH,     01008H,07FFEH,
  40.                            01008H, 03FFCH,       00000H,               027E4H,
  41.                            007E0H, 02004H,       00000H,               0700EH,
  42.                  00000H,00000H,    0700EH,       00000H,     02004H,00000H,
  43.        00000H) ;
  44.      END SpriteData ;
  45.  
  46. PROCEDURE Quit ;
  47.      BEGIN
  48.         IF (MemPtr    # NIL) THEN FreeMem(MemPtr,72) ; END ;
  49.         IF (NumSprite # -1)  THEN FreeSprite(NumSprite) ; END ;
  50.      END Quit ;
  51.  
  52. BEGIN (* MAIN PROGRAM *)
  53.      NumSprite := -1 ;
  54.      TermProcedure(Quit) ;
  55.      MemPtr := AllocMem(72,MemReqSet{memClear,public,chip}) ;
  56.      IF (MemPtr = NIL) THEN HALT ; END ;
  57.      CopyMem(ADR(SpriteData),MemPtr,72) ;
  58.      WITH SimSprite DO
  59.         posctldata := MemPtr ;
  60.         height     := 16 ;
  61.      END ;
  62.      NumSprite := GetSprite(ADR(SimSprite),-1) ;
  63.      IF (NumSprite = -1) THEN HALT ; END ;
  64.      IBase     := OpenIntuition() ;
  65.  
  66.      LOOP
  67.         Delay(1) ;
  68.         ScrPtr := IBase^.activeScreen ;
  69.         Raster := ADR(ScrPtr^.rastPort) ;
  70.         Viewer := ADR(ScrPtr^.viewPort) ;
  71.         IF (hires IN Viewer^.modes) THEN xf := xs+16 ; minx := -29 ;
  72.                                     ELSE xf := xs+8  ; minx := -14 ; END ;
  73.         IF (lace  IN Viewer^.modes) THEN yf := ys-2  ; miny := -29 ;
  74.                                     ELSE yf := ys-1  ; miny := -14 ; END ;
  75.         CASE ORD(CIAA) OF
  76.            |067H : DEC(ys) ;
  77.            |065H : INC(ys) ;
  78.            |061H : DEC(xs) ;
  79.            |063H : INC(xs) ;
  80.            |075H : Terminate(0) ;
  81.            |07FH : i := yf ;
  82.                    WHILE (ReadPixel(Raster,xf,i) = 0) DO DEC(i) ; END ;
  83.                    SetAPen(Raster,1) ; Move(Raster,xf,yf) ; Draw(Raster,xf,i) ;
  84.                    Delay(9);
  85.                    SetAPen(Raster,0) ; Move(Raster,xf,yf) ; Draw(Raster,xf,i) ;
  86.            ELSE
  87.         END ;
  88.         IF (xs>ScrPtr^.width-2)  THEN xs := minx ; END ;
  89.         IF (xs<minx)             THEN xs := ScrPtr^.width-2 ; END ;
  90.         IF (ys>ScrPtr^.height-2) THEN ys := miny ; END ;
  91.         IF (ys<miny)             THEN ys := ScrPtr^.height-2 ; END ;
  92.         MoveSprite(Viewer,ADR(SimSprite),xs,ys) ;
  93.      END ;
  94. END UFO.
  95.